home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro20 / window.bas < prev   
Encoding:
BASIC Source File  |  1988-11-01  |  5.8 KB  |  174 lines
  1. '************************************************************************
  2. ' Window Driver Routines
  3. ' Written By Kyle Sparks, Microsoft, 1988
  4. '
  5. 'for use inside the QB4 environment, must have QB.QLB Quick Library loaded
  6. '
  7. '************************************************************************
  8.  
  9.    DEFINT A-Z
  10.  
  11. '----------------------------- Define Types -----------------------------
  12.  
  13.    TYPE RegType                       'Type for use with Interrupt
  14.       AX    AS INTEGER
  15.       BX    AS INTEGER
  16.       CX    AS INTEGER
  17.       DX    AS INTEGER
  18.       BP    AS INTEGER
  19.       SI    AS INTEGER
  20.       DI    AS INTEGER
  21.       FLAGS AS INTEGER
  22.       DS    AS INTEGER
  23.       ES    AS INTEGER
  24.    END TYPE
  25.  
  26. '-------------------------- Declare Procedures --------------------------
  27.  
  28.    DECLARE FUNCTION SetVideoSegment ()
  29.    DECLARE SUB GetVideoMode (VidMode)
  30.    DECLARE SUB KillWindow (XStart, YStart, DeltaX, DeltaY, WindowMemory$)
  31.    DECLARE SUB MakeWindow (XStart, YStart, DeltaX, DeltaY, ForeColor, BackColor, Border, WindowMemory$)
  32.    DECLARE SUB ScrollUp (AL, BH, CH, CL, DH, DL)
  33.    DECLARE SUB ScrollDown (AL, BH, CH, CL, DH, DL)
  34.  
  35.    DECLARE SUB INTERRUPT (IntNo%, InRegs AS RegType, OutRegs AS RegType)
  36.    DECLARE SUB InterruptX (IntNo%, InRegs AS RegType, OutRegs AS RegType)
  37.  
  38. '------------------------------------------------------------------------
  39.  
  40. SUB GetVideoMode (VidMode)
  41. '------------------------------------------------------------------------
  42. '  procedure GetVideoMode returns the current video mode in VidMode.
  43. '------------------------------------------------------------------------
  44.  
  45.    DIM regs AS RegType
  46.    regs.AX = (&HF * 256) + 0
  47.    INTERRUPT &H10, regs, regs
  48.    VidMode = (regs.AX MOD 256)
  49.  
  50. END SUB
  51.  
  52. SUB KillWindow (XStart, YStart, DeltaX, DeltaY, WindowMemory$)
  53. '------------------------------------------------------------------------
  54. '  procedure KillWindow removes a popup window made by MakeWindow
  55. '------------------------------------------------------------------------
  56.   
  57.    DelX = DeltaX - 1
  58.    DelY = DeltaY - 1
  59.  
  60.    'Restore Screen
  61.  
  62.    CALL ScrRstr(WindowMemory$)
  63.  
  64. END SUB
  65.  
  66. SUB MakeWindow (XStart, YStart, DeltaX, DeltaY, ForeColor, BackColor, Border, WindowMemory$)
  67. '------------------------------------------------------------------------
  68. '  procedure MakeWindow stores a specified portion of the screen in a
  69. '  buffer, then makes a window with a border of the specified style and
  70. '  color.
  71. '------------------------------------------------------------------------
  72.   
  73.    IF Border = 1 THEN
  74.         UpLeft$ = CHR$(218)
  75.        LowLeft$ = CHR$(192)
  76.        UpRight$ = CHR$(191)
  77.       LowRight$ = CHR$(217)
  78.          Horiz$ = CHR$(196)
  79.           Vert$ = CHR$(179)
  80.    ELSE
  81.         UpLeft$ = CHR$(201)
  82.        LowLeft$ = CHR$(200)
  83.        UpRight$ = CHR$(187)
  84.       LowRight$ = CHR$(188)
  85.          Horiz$ = CHR$(205)
  86.           Vert$ = CHR$(186)
  87.    END IF
  88.    
  89.    WindowMemory$ = SPACE$(4000)
  90.  
  91.    l& = FRE("")
  92.  
  93.    DelX = DeltaX - 1
  94.    DelY = DeltaY - 1
  95.  
  96.    CALL ScrSave(WindowMemory$)
  97.  
  98.    'Make window
  99.  
  100.    CT = 0
  101.    LOCATE YStart + CT, XStart: COLOR BackColor, ForeColor: PRINT UpLeft$; STRING$(1 + (DelX - 2), Horiz$); UpRight$; : COLOR ForeColor, BackColor: CT = CT + 1
  102.    FOR PP = 1 TO DelY - 1
  103.       LOCATE YStart + CT, XStart: COLOR BackColor, ForeColor: PRINT Vert$; : COLOR ForeColor, BackColor: PRINT STRING$(1 + (DelX - 2), " "); : COLOR BackColor, ForeColor: PRINT Vert$; : COLOR ForeColor, BackColor: CT = CT + 1
  104.    NEXT PP
  105.    LOCATE YStart + CT, XStart: COLOR BackColor, ForeColor: PRINT LowLeft$; STRING$(1 + (DelX - 2), Horiz$); LowRight$; : COLOR ForeColor, BackColor
  106.  
  107. END SUB
  108.  
  109. SUB ScrollDown (AL, BH, CH, CL, DH, DL)
  110. '------------------------------------------------------------------------
  111. '  procedure ScrollDown scrolls the designated area of the screen down.
  112. '
  113. '  AL  -  Number of lines to scoll window
  114. '  BH  -  Number of color attribute to be used for blanked area
  115. '  CH  -  Y coordinate of upper left corner of window to be scrolled
  116. '  CL  -  X coordinate of upper left corner of window to be scrolled
  117. '  DH  -  Y coordinate of lower right corner of window to be scrolled
  118. '  DL  -  X coordinate of lower right corner of window to be scrolled
  119. '------------------------------------------------------------------------
  120.  
  121.   CH = CH - 1
  122.   CL = CL - 1
  123.   DH = DH - 1
  124.   DL = DL - 1
  125.   DIM regs AS RegType
  126.   regs.AX = (256 * &H7) + AL
  127.   regs.BX = (256 * BH)
  128.   regs.CX = (256 * CH) + CL
  129.   regs.DX = (256 * DH) + DL
  130.   INTERRUPT &H10, regs, regs
  131. END SUB
  132.  
  133. SUB ScrollUp (AL, BH, CH, CL, DH, DL)
  134. '------------------------------------------------------------------------
  135. '  procedure ScrollDown scrolls the designated area of the screen down.
  136. '
  137. '  AL  -  Number of lines to scoll window
  138. '  BH  -  Number of color attribute to be used for blanked area
  139. '  CH  -  Y coordinate of upper left corner of window to be scrolled
  140. '  CL  -  X coordinate of upper left corner of window to be scrolled
  141. '  DH  -  Y coordinate of lower right corner of window to be scrolled
  142. '  DL  -  X coordinate of lower right corner of window to be scrolled
  143. '------------------------------------------------------------------------
  144.  
  145.   CH = CH - 1
  146.   CL = CL - 1
  147.   DH = DH - 1
  148.   DL = DL - 1
  149.   DIM regs AS RegType
  150.   regs.AX = (256 * &H6) + AL
  151.   regs.BX = (256 * BH)
  152.   regs.CX = (256 * CH) + CL
  153.   regs.DX = (256 * DH) + DL
  154.   INTERRUPT &H10, regs, regs
  155. END SUB
  156.  
  157. FUNCTION SetVideoSegment
  158.  
  159.    DEF SEG = 0
  160.  
  161.    SELECT CASE PEEK(&H449)    'Figure out what video mode is being used
  162.       CASE 0 TO 3
  163.          DEF SEG = &HB800     'CGA and EGA text modes
  164.       CASE 7
  165.          DEF SEG = &HB000     'Monochrome text mode
  166.       CASE ELSE
  167.          CLS                  'Not a text mode, or not a compatible card
  168.          SetVideoSegment = &HFF
  169.          EXIT FUNCTION
  170.    END SELECT
  171.  
  172. END FUNCTION
  173.  
  174.